home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / gnu / dejagnu.lha / dejagnu-1.0.1 / tcl / tclHash.c < prev    next >
C/C++ Source or Header  |  1993-02-13  |  25KB  |  929 lines
  1. /* 
  2.  * tclHash.c --
  3.  *
  4.  *    Implementation of in-memory hash tables for Tcl and Tcl-based
  5.  *    applications.
  6.  *
  7.  * Copyright 1991 Regents of the University of California
  8.  * Permission to use, copy, modify, and distribute this
  9.  * software and its documentation for any purpose and without
  10.  * fee is hereby granted, provided that this copyright
  11.  * notice appears in all copies.  The University of California
  12.  * makes no representations about the suitability of this
  13.  * software for any purpose.  It is provided "as is" without
  14.  * express or implied warranty.
  15.  */
  16.  
  17. #include "tclInt.h"
  18.  
  19. /*
  20.  * Imported library procedures for which there are no header files:
  21.  */
  22.  
  23. extern void panic();
  24.  
  25. /*
  26.  * When there are this many entries per bucket, on average, rebuild
  27.  * the hash table to make it larger.
  28.  */
  29.  
  30. #define REBUILD_MULTIPLIER    3
  31.  
  32.  
  33. /*
  34.  * The following macro takes a preliminary integer hash value and
  35.  * produces an index into a hash tables bucket list.  The idea is
  36.  * to make it so that preliminary values that are arbitrarily similar
  37.  * will end up in different buckets.  The hash function was taken
  38.  * from a random-number generator.
  39.  */
  40.  
  41. #define RANDOM_INDEX(tablePtr, i) \
  42.     (((((long) (i))*1103515245) >> (tablePtr)->downShift) & (tablePtr)->mask)
  43.  
  44. /*
  45.  * Procedure prototypes for static procedures in this file:
  46.  */
  47.  
  48. static Tcl_HashEntry *    ArrayFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  49.                 char *key));
  50. static Tcl_HashEntry *    ArrayCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  51.                 char *key, int *newPtr));
  52. static Tcl_HashEntry *    BogusFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  53.                 char *key));
  54. static Tcl_HashEntry *    BogusCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  55.                 char *key, int *newPtr));
  56. static unsigned int    HashString _ANSI_ARGS_((char *string));
  57. static void        RebuildTable _ANSI_ARGS_((Tcl_HashTable *tablePtr));
  58. static Tcl_HashEntry *    StringFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  59.                 char *key));
  60. static Tcl_HashEntry *    StringCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  61.                 char *key, int *newPtr));
  62. static Tcl_HashEntry *    OneWordFind _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  63.                 char *key));
  64. static Tcl_HashEntry *    OneWordCreate _ANSI_ARGS_((Tcl_HashTable *tablePtr,
  65.                 char *key, int *newPtr));
  66.  
  67. /*
  68.  *----------------------------------------------------------------------
  69.  *
  70.  * Tcl_InitHashTable --
  71.  *
  72.  *    Given storage for a hash table, set up the fields to prepare
  73.  *    the hash table for use.
  74.  *
  75.  * Results:
  76.  *    None.
  77.  *
  78.  * Side effects:
  79.  *    TablePtr is now ready to be passed to Tcl_FindHashEntry and
  80.  *    Tcl_CreateHashEntry.
  81.  *
  82.  *----------------------------------------------------------------------
  83.  */
  84.  
  85. void
  86. Tcl_InitHashTable(tablePtr, keyType)
  87.     register Tcl_HashTable *tablePtr;    /* Pointer to table record, which
  88.                      * is supplied by the caller. */
  89.     int keyType;            /* Type of keys to use in table:
  90.                      * TCL_STRING_KEYS, TCL_ONE_WORD_KEYS,
  91.                      * or an integer >= 2. */
  92. {
  93.     tablePtr->buckets = tablePtr->staticBuckets;
  94.     tablePtr->staticBuckets[0] = tablePtr->staticBuckets[1] = 0;
  95.     tablePtr->staticBuckets[2] = tablePtr->staticBuckets[3] = 0;
  96.     tablePtr->numBuckets = TCL_SMALL_HASH_TABLE;
  97.     tablePtr->numEntries = 0;
  98.     tablePtr->rebuildSize = TCL_SMALL_HASH_TABLE*REBUILD_MULTIPLIER;
  99.     tablePtr->downShift = 28;
  100.     tablePtr->mask = 3;
  101.     tablePtr->keyType = keyType;
  102.     if (keyType == TCL_STRING_KEYS) {
  103.     tablePtr->findProc = StringFind;
  104.     tablePtr->createProc = StringCreate;
  105.     } else if (keyType == TCL_ONE_WORD_KEYS) {
  106.     tablePtr->findProc = OneWordFind;
  107.     tablePtr->createProc = OneWordCreate;
  108.     } else {
  109.     tablePtr->findProc = ArrayFind;
  110.     tablePtr->createProc = ArrayCreate;
  111.     };
  112. }
  113.  
  114. /*
  115.  *----------------------------------------------------------------------
  116.  *
  117.  * Tcl_DeleteHashEntry --
  118.  *
  119.  *    Remove a single entry from a hash table.
  120.  *
  121.  * Results:
  122.  *    None.
  123.  *
  124.  * Side effects:
  125.  *    The entry given by entryPtr is deleted from its table and
  126.  *    should never again be used by the caller.  It is up to the
  127.  *    caller to free the clientData field of the entry, if that
  128.  *    is relevant.
  129.  *
  130.  *----------------------------------------------------------------------
  131.  */
  132.  
  133. void
  134. Tcl_DeleteHashEntry(entryPtr)
  135.     Tcl_HashEntry *entryPtr;
  136. {
  137.     register Tcl_HashEntry *prevPtr;
  138.  
  139.     if (*entryPtr->bucketPtr == entryPtr) {
  140.     *entryPtr->bucketPtr = entryPtr->nextPtr;
  141.     } else {
  142.     for (prevPtr = *entryPtr->bucketPtr; ; prevPtr = prevPtr->nextPtr) {
  143.         if (prevPtr == NULL) {
  144.         panic("malformed bucket chain in Tcl_DeleteHashEntry");
  145.         }
  146.         if (prevPtr->nextPtr == entryPtr) {
  147.         prevPtr->nextPtr = entryPtr->nextPtr;
  148.         break;
  149.         }
  150.     }
  151.     }
  152.     entryPtr->tablePtr->numEntries--;
  153.     ckfree((char *) entryPtr);
  154. }
  155.  
  156. /*
  157.  *----------------------------------------------------------------------
  158.  *
  159.  * Tcl_DeleteHashTable --
  160.  *
  161.  *    Free up everything associated with a hash table except for
  162.  *    the record for the table itself.
  163.  *
  164.  * Results:
  165.  *    None.
  166.  *
  167.  * Side effects:
  168.  *    The hash table is no longer useable.
  169.  *
  170.  *----------------------------------------------------------------------
  171.  */
  172.  
  173. void
  174. Tcl_DeleteHashTable(tablePtr)
  175.     register Tcl_HashTable *tablePtr;        /* Table to delete. */
  176. {
  177.     register Tcl_HashEntry *hPtr, *nextPtr;
  178.     int i;
  179.  
  180.     /*
  181.      * Free up all the entries in the table.
  182.      */
  183.  
  184.     for (i = 0; i < tablePtr->numBuckets; i++) {
  185.     hPtr = tablePtr->buckets[i];
  186.     while (hPtr != NULL) {
  187.         nextPtr = hPtr->nextPtr;
  188.         ckfree((char *) hPtr);
  189.         hPtr = nextPtr;
  190.     }
  191.     }
  192.  
  193.     /*
  194.      * Free up the bucket array, if it was dynamically allocated.
  195.      */
  196.  
  197.     if (tablePtr->buckets != tablePtr->staticBuckets) {
  198.     ckfree((char *) tablePtr->buckets);
  199.     }
  200.  
  201.     /*
  202.      * Arrange for panics if the table is used again without
  203.      * re-initialization.
  204.      */
  205.  
  206.     tablePtr->findProc = BogusFind;
  207.     tablePtr->createProc = BogusCreate;
  208. }
  209.  
  210. /*
  211.  *----------------------------------------------------------------------
  212.  *
  213.  * Tcl_FirstHashEntry --
  214.  *
  215.  *    Locate the first entry in a hash table and set up a record
  216.  *    that can be used to step through all the remaining entries
  217.  *    of the table.
  218.  *
  219.  * Results:
  220.  *    The return value is a pointer to the first entry in tablePtr,
  221.  *    or NULL if tablePtr has no entries in it.  The memory at
  222.  *    *searchPtr is initialized so that subsequent calls to
  223.  *    Tcl_NextHashEntry will return all of the entries in the table,
  224.  *    one at a time.
  225.  *
  226.  * Side effects:
  227.  *    None.
  228.  *
  229.  *----------------------------------------------------------------------
  230.  */
  231.  
  232. Tcl_HashEntry *
  233. Tcl_FirstHashEntry(tablePtr, searchPtr)
  234.     Tcl_HashTable *tablePtr;        /* Table to search. */
  235.     Tcl_HashSearch *searchPtr;        /* Place to store information about
  236.                      * progress through the table. */
  237. {
  238.     searchPtr->tablePtr = tablePtr;
  239.     searchPtr->nextIndex = 0;
  240.     searchPtr->nextEntryPtr = NULL;
  241.     return Tcl_NextHashEntry(searchPtr);
  242. }
  243.  
  244. /*
  245.  *----------------------------------------------------------------------
  246.  *
  247.  * Tcl_NextHashEntry --
  248.  *
  249.  *    Once a hash table enumeration has been initiated by calling
  250.  *    Tcl_FirstHashEntry, this procedure may be called to return
  251.  *    successive elements of the table.
  252.  *
  253.  * Results:
  254.  *    The return value is the next entry in the hash table being
  255.  *    enumerated, or NULL if the end of the table is reached.
  256.  *
  257.  * Side effects:
  258.  *    None.
  259.  *
  260.  *----------------------------------------------------------------------
  261.  */
  262.  
  263. Tcl_HashEntry *
  264. Tcl_NextHashEntry(searchPtr)
  265.     register Tcl_HashSearch *searchPtr;    /* Place to store information about
  266.                      * progress through the table.  Must
  267.                      * have been initialized by calling
  268.                      * Tcl_FirstHashEntry. */
  269. {
  270.     Tcl_HashEntry *hPtr;
  271.  
  272.     while (searchPtr->nextEntryPtr == NULL) {
  273.     if (searchPtr->nextIndex >= searchPtr->tablePtr->numBuckets) {
  274.         return NULL;
  275.     }
  276.     searchPtr->nextEntryPtr =
  277.         searchPtr->tablePtr->buckets[searchPtr->nextIndex];
  278.     searchPtr->nextIndex++;
  279.     }
  280.     hPtr = searchPtr->nextEntryPtr;
  281.     searchPtr->nextEntryPtr = hPtr->nextPtr;
  282.     return hPtr;
  283. }
  284.  
  285. /*
  286.  *----------------------------------------------------------------------
  287.  *
  288.  * Tcl_HashStats --
  289.  *
  290.  *    Return statistics describing the layout of the hash table
  291.  *    in its hash buckets.
  292.  *
  293.  * Results:
  294.  *    The return value is a malloc-ed string containing information
  295.  *    about tablePtr.  It is the caller's responsibility to free
  296.  *    this string.
  297.  *
  298.  * Side effects:
  299.  *    None.
  300.  *
  301.  *----------------------------------------------------------------------
  302.  */
  303.  
  304. char *
  305. Tcl_HashStats(tablePtr)
  306.     Tcl_HashTable *tablePtr;        /* Table for which to produce stats. */
  307. {
  308. #define NUM_COUNTERS 10
  309.     int count[NUM_COUNTERS], overflow, i, j;
  310.     double average, tmp;
  311.     register Tcl_HashEntry *hPtr;
  312.     char *result, *p;
  313.  
  314.     /*
  315.      * Compute a histogram of bucket usage.
  316.      */
  317.  
  318.     for (i = 0; i < NUM_COUNTERS; i++) {
  319.     count[i] = 0;
  320.     }
  321.     overflow = 0;
  322.     average = 0.0;
  323.     for (i = 0; i < tablePtr->numBuckets; i++) {
  324.     j = 0;
  325.     for (hPtr = tablePtr->buckets[i]; hPtr != NULL; hPtr = hPtr->nextPtr) {
  326.         j++;
  327.     }
  328.     if (j < NUM_COUNTERS) {
  329.         count[j]++;
  330.     } else {
  331.         overflow++;
  332.     }
  333.     tmp = j;
  334.     average += (tmp+1.0)*(tmp/tablePtr->numEntries)/2.0;
  335.     }
  336.  
  337.     /*
  338.      * Print out the histogram and a few other pieces of information.
  339.      */
  340.  
  341.     result = (char *) ckalloc((unsigned) ((NUM_COUNTERS*60) + 300));
  342.     sprintf(result, "%d entries in table, %d buckets\n",
  343.         tablePtr->numEntries, tablePtr->numBuckets);
  344.     p = result + strlen(result);
  345.     for (i = 0; i < NUM_COUNTERS; i++) {
  346.     sprintf(p, "number of buckets with %d entries: %d\n",
  347.         i, count[i]);
  348.     p += strlen(p);
  349.     }
  350.     sprintf(p, "number of buckets with more %d or more entries: %d\n",
  351.         NUM_COUNTERS, overflow);
  352.     p += strlen(p);
  353.     sprintf(p, "average search distance for entry: %.1f", average);
  354.     return result;
  355. }
  356.  
  357. /*
  358.  *----------------------------------------------------------------------
  359.  *
  360.  * HashString --
  361.  *
  362.  *    Compute a one-word summary of a text string, which can be
  363.  *    used to generate a hash index.
  364.  *
  365.  * Results:
  366.  *    The return value is a one-word summary of the information in
  367.  *    string.
  368.  *
  369.  * Side effects:
  370.  *    None.
  371.  *
  372.  *----------------------------------------------------------------------
  373.  */
  374.  
  375. static unsigned int
  376. HashString(string)
  377.     register char *string;    /* String from which to compute hash value. */
  378. {
  379.     register unsigned int result;
  380.     register int c;
  381.  
  382.     /*
  383.      * I tried a zillion different hash functions and asked many other
  384.      * people for advice.  Many people had their own favorite functions,
  385.      * all different, but no-one had much idea why they were good ones.
  386.      * I chose the one below (multiply by 9 and add new character)
  387.      * because of the following reasons:
  388.      *
  389.      * 1. Multiplying by 10 is perfect for keys that are decimal strings,
  390.      *    and multiplying by 9 is just about as good.
  391.      * 2. Times-9 is (shift-left-3) plus (old).  This means that each
  392.      *    character's bits hang around in the low-order bits of the
  393.      *    hash value for ever, plus they spread fairly rapidly up to
  394.      *    the high-order bits to fill out the hash value.  This seems
  395.      *    works well both for decimal and non-decimal strings.
  396.      */
  397.  
  398.     result = 0;
  399.     while (1) {
  400.     c = *string;
  401.     string++;
  402.     if (c == 0) {
  403.         break;
  404.     }
  405.     result += (result<<3) + c;
  406.     }
  407.     return result;
  408. }
  409.  
  410. /*
  411.  *----------------------------------------------------------------------
  412.  *
  413.  * StringFind --
  414.  *
  415.  *    Given a hash table with string keys, and a string key, find
  416.  *    the entry with a matching key.
  417.  *
  418.  * Results:
  419.  *    The return value is a token for the matching entry in the
  420.  *    hash table, or NULL if there was no matching entry.
  421.  *
  422.  * Side effects:
  423.  *    None.
  424.  *
  425.  *----------------------------------------------------------------------
  426.  */
  427.  
  428. static Tcl_HashEntry *
  429. StringFind(tablePtr, key)
  430.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  431.     char *key;            /* Key to use to find matching entry. */
  432. {
  433.     register Tcl_HashEntry *hPtr;
  434.     register char *p1, *p2;
  435.     int index;
  436.  
  437.     index = HashString(key) & tablePtr->mask;
  438.  
  439.     /*
  440.      * Search all of the entries in the appropriate bucket.
  441.      */
  442.  
  443.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  444.         hPtr = hPtr->nextPtr) {
  445.     for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
  446.         if (*p1 != *p2) {
  447.         break;
  448.         }
  449.         if (*p1 == '\0') {
  450.         return hPtr;
  451.         }
  452.     }
  453.     }
  454.     return NULL;
  455. }
  456.  
  457. /*
  458.  *----------------------------------------------------------------------
  459.  *
  460.  * StringCreate --
  461.  *
  462.  *    Given a hash table with string keys, and a string key, find
  463.  *    the entry with a matching key.  If there is no matching entry,
  464.  *    then create a new entry that does match.
  465.  *
  466.  * Results:
  467.  *    The return value is a pointer to the matching entry.  If this
  468.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  469.  *    value;  otherwise *newPtr will be set to 0.  If this is a new
  470.  *    entry the value stored in the entry will initially be 0.
  471.  *
  472.  * Side effects:
  473.  *    A new entry may be added to the hash table.
  474.  *
  475.  *----------------------------------------------------------------------
  476.  */
  477.  
  478. static Tcl_HashEntry *
  479. StringCreate(tablePtr, key, newPtr)
  480.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  481.     char *key;            /* Key to use to find or create matching
  482.                  * entry. */
  483.     int *newPtr;        /* Store info here telling whether a new
  484.                  * entry was created. */
  485. {
  486.     register Tcl_HashEntry *hPtr;
  487.     register char *p1, *p2;
  488.     int index;
  489.  
  490.     index = HashString(key) & tablePtr->mask;
  491.  
  492.     /*
  493.      * Search all of the entries in this bucket.
  494.      */
  495.  
  496.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  497.         hPtr = hPtr->nextPtr) {
  498.     for (p1 = key, p2 = hPtr->key.string; ; p1++, p2++) {
  499.         if (*p1 != *p2) {
  500.         break;
  501.         }
  502.         if (*p1 == '\0') {
  503.         *newPtr = 0;
  504.         return hPtr;
  505.         }
  506.     }
  507.     }
  508.  
  509.     /*
  510.      * Entry not found.  Add a new one to the bucket.
  511.      */
  512.  
  513.     *newPtr = 1;
  514.     hPtr = (Tcl_HashEntry *) ckalloc((unsigned)
  515.         (sizeof(Tcl_HashEntry) + strlen(key) - (sizeof(hPtr->key) -1)));
  516.     hPtr->tablePtr = tablePtr;
  517.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  518.     hPtr->nextPtr = *hPtr->bucketPtr;
  519.     hPtr->clientData = 0;
  520.     strcpy(hPtr->key.string, key);
  521.     *hPtr->bucketPtr = hPtr;
  522.     tablePtr->numEntries++;
  523.  
  524.     /*
  525.      * If the table has exceeded a decent size, rebuild it with many
  526.      * more buckets.
  527.      */
  528.  
  529.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  530.     RebuildTable(tablePtr);
  531.     }
  532.     return hPtr;
  533. }
  534.  
  535. /*
  536.  *----------------------------------------------------------------------
  537.  *
  538.  * OneWordFind --
  539.  *
  540.  *    Given a hash table with one-word keys, and a one-word key, find
  541.  *    the entry with a matching key.
  542.  *
  543.  * Results:
  544.  *    The return value is a token for the matching entry in the
  545.  *    hash table, or NULL if there was no matching entry.
  546.  *
  547.  * Side effects:
  548.  *    None.
  549.  *
  550.  *----------------------------------------------------------------------
  551.  */
  552.  
  553. static Tcl_HashEntry *
  554. OneWordFind(tablePtr, key)
  555.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  556.     register char *key;        /* Key to use to find matching entry. */
  557. {
  558.     register Tcl_HashEntry *hPtr;
  559.     int index;
  560.  
  561.     index = RANDOM_INDEX(tablePtr, key);
  562.  
  563.     /*
  564.      * Search all of the entries in the appropriate bucket.
  565.      */
  566.  
  567.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  568.         hPtr = hPtr->nextPtr) {
  569.     if (hPtr->key.oneWordValue == key) {
  570.         return hPtr;
  571.     }
  572.     }
  573.     return NULL;
  574. }
  575.  
  576. /*
  577.  *----------------------------------------------------------------------
  578.  *
  579.  * OneWordCreate --
  580.  *
  581.  *    Given a hash table with one-word keys, and a one-word key, find
  582.  *    the entry with a matching key.  If there is no matching entry,
  583.  *    then create a new entry that does match.
  584.  *
  585.  * Results:
  586.  *    The return value is a pointer to the matching entry.  If this
  587.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  588.  *    value;  otherwise *newPtr will be set to 0.  If this is a new
  589.  *    entry the value stored in the entry will initially be 0.
  590.  *
  591.  * Side effects:
  592.  *    A new entry may be added to the hash table.
  593.  *
  594.  *----------------------------------------------------------------------
  595.  */
  596.  
  597. static Tcl_HashEntry *
  598. OneWordCreate(tablePtr, key, newPtr)
  599.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  600.     register char *key;        /* Key to use to find or create matching
  601.                  * entry. */
  602.     int *newPtr;        /* Store info here telling whether a new
  603.                  * entry was created. */
  604. {
  605.     register Tcl_HashEntry *hPtr;
  606.     int index;
  607.  
  608.     index = RANDOM_INDEX(tablePtr, key);
  609.  
  610.     /*
  611.      * Search all of the entries in this bucket.
  612.      */
  613.  
  614.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  615.         hPtr = hPtr->nextPtr) {
  616.     if (hPtr->key.oneWordValue == key) {
  617.         *newPtr = 0;
  618.         return hPtr;
  619.     }
  620.     }
  621.  
  622.     /*
  623.      * Entry not found.  Add a new one to the bucket.
  624.      */
  625.  
  626.     *newPtr = 1;
  627.     hPtr = (Tcl_HashEntry *) ckalloc(sizeof(Tcl_HashEntry));
  628.     hPtr->tablePtr = tablePtr;
  629.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  630.     hPtr->nextPtr = *hPtr->bucketPtr;
  631.     hPtr->clientData = 0;
  632.     hPtr->key.oneWordValue = key;
  633.     *hPtr->bucketPtr = hPtr;
  634.     tablePtr->numEntries++;
  635.  
  636.     /*
  637.      * If the table has exceeded a decent size, rebuild it with many
  638.      * more buckets.
  639.      */
  640.  
  641.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  642.     RebuildTable(tablePtr);
  643.     }
  644.     return hPtr;
  645. }
  646.  
  647. /*
  648.  *----------------------------------------------------------------------
  649.  *
  650.  * ArrayFind --
  651.  *
  652.  *    Given a hash table with array-of-int keys, and a key, find
  653.  *    the entry with a matching key.
  654.  *
  655.  * Results:
  656.  *    The return value is a token for the matching entry in the
  657.  *    hash table, or NULL if there was no matching entry.
  658.  *
  659.  * Side effects:
  660.  *    None.
  661.  *
  662.  *----------------------------------------------------------------------
  663.  */
  664.  
  665. static Tcl_HashEntry *
  666. ArrayFind(tablePtr, key)
  667.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  668.     char *key;            /* Key to use to find matching entry. */
  669. {
  670.     register Tcl_HashEntry *hPtr;
  671.     int *arrayPtr = (int *) key;
  672.     register int *iPtr1, *iPtr2;
  673.     int index, count;
  674.  
  675.     for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
  676.         count > 0; count--, iPtr1++) {
  677.     index += *iPtr1;
  678.     }
  679.     index = RANDOM_INDEX(tablePtr, index);
  680.  
  681.     /*
  682.      * Search all of the entries in the appropriate bucket.
  683.      */
  684.  
  685.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  686.         hPtr = hPtr->nextPtr) {
  687.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
  688.         count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
  689.         if (count == 0) {
  690.         return hPtr;
  691.         }
  692.         if (*iPtr1 != *iPtr2) {
  693.         break;
  694.         }
  695.     }
  696.     }
  697.     return NULL;
  698. }
  699.  
  700. /*
  701.  *----------------------------------------------------------------------
  702.  *
  703.  * ArrayCreate --
  704.  *
  705.  *    Given a hash table with one-word keys, and a one-word key, find
  706.  *    the entry with a matching key.  If there is no matching entry,
  707.  *    then create a new entry that does match.
  708.  *
  709.  * Results:
  710.  *    The return value is a pointer to the matching entry.  If this
  711.  *    is a newly-created entry, then *newPtr will be set to a non-zero
  712.  *    value;  otherwise *newPtr will be set to 0.  If this is a new
  713.  *    entry the value stored in the entry will initially be 0.
  714.  *
  715.  * Side effects:
  716.  *    A new entry may be added to the hash table.
  717.  *
  718.  *----------------------------------------------------------------------
  719.  */
  720.  
  721. static Tcl_HashEntry *
  722. ArrayCreate(tablePtr, key, newPtr)
  723.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  724.     register char *key;        /* Key to use to find or create matching
  725.                  * entry. */
  726.     int *newPtr;        /* Store info here telling whether a new
  727.                  * entry was created. */
  728. {
  729.     register Tcl_HashEntry *hPtr;
  730.     int *arrayPtr = (int *) key;
  731.     register int *iPtr1, *iPtr2;
  732.     int index, count;
  733.  
  734.     for (index = 0, count = tablePtr->keyType, iPtr1 = arrayPtr;
  735.         count > 0; count--, iPtr1++) {
  736.     index += *iPtr1;
  737.     }
  738.     index = RANDOM_INDEX(tablePtr, index);
  739.  
  740.     /*
  741.      * Search all of the entries in the appropriate bucket.
  742.      */
  743.  
  744.     for (hPtr = tablePtr->buckets[index]; hPtr != NULL;
  745.         hPtr = hPtr->nextPtr) {
  746.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words,
  747.         count = tablePtr->keyType; ; count--, iPtr1++, iPtr2++) {
  748.         if (count == 0) {
  749.         *newPtr = 0;
  750.         return hPtr;
  751.         }
  752.         if (*iPtr1 != *iPtr2) {
  753.         break;
  754.         }
  755.     }
  756.     }
  757.  
  758.     /*
  759.      * Entry not found.  Add a new one to the bucket.
  760.      */
  761.  
  762.     *newPtr = 1;
  763.     hPtr = (Tcl_HashEntry *) ckalloc((unsigned) (sizeof(Tcl_HashEntry)
  764.         + (tablePtr->keyType*sizeof(int)) - 4));
  765.     hPtr->tablePtr = tablePtr;
  766.     hPtr->bucketPtr = &(tablePtr->buckets[index]);
  767.     hPtr->nextPtr = *hPtr->bucketPtr;
  768.     hPtr->clientData = 0;
  769.     for (iPtr1 = arrayPtr, iPtr2 = hPtr->key.words, count = tablePtr->keyType;
  770.         count > 0; count--, iPtr1++, iPtr2++) {
  771.     *iPtr2 = *iPtr1;
  772.     }
  773.     *hPtr->bucketPtr = hPtr;
  774.     tablePtr->numEntries++;
  775.  
  776.     /*
  777.      * If the table has exceeded a decent size, rebuild it with many
  778.      * more buckets.
  779.      */
  780.  
  781.     if (tablePtr->numEntries >= tablePtr->rebuildSize) {
  782.     RebuildTable(tablePtr);
  783.     }
  784.     return hPtr;
  785. }
  786.  
  787. /*
  788.  *----------------------------------------------------------------------
  789.  *
  790.  * BogusFind --
  791.  *
  792.  *    This procedure is invoked when an Tcl_FindHashEntry is called
  793.  *    on a table that has been deleted.
  794.  *
  795.  * Results:
  796.  *    If panic returns (which it shouldn't) this procedure returns
  797.  *    NULL.
  798.  *
  799.  * Side effects:
  800.  *    Generates a panic.
  801.  *
  802.  *----------------------------------------------------------------------
  803.  */
  804.  
  805.     /* ARGSUSED */
  806. static Tcl_HashEntry *
  807. BogusFind(tablePtr, key)
  808.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  809.     char *key;            /* Key to use to find matching entry. */
  810. {
  811.     panic("called Tcl_FindHashEntry on deleted table");
  812.     return NULL;
  813. }
  814.  
  815. /*
  816.  *----------------------------------------------------------------------
  817.  *
  818.  * BogusCreate --
  819.  *
  820.  *    This procedure is invoked when an Tcl_CreateHashEntry is called
  821.  *    on a table that has been deleted.
  822.  *
  823.  * Results:
  824.  *    If panic returns (which it shouldn't) this procedure returns
  825.  *    NULL.
  826.  *
  827.  * Side effects:
  828.  *    Generates a panic.
  829.  *
  830.  *----------------------------------------------------------------------
  831.  */
  832.  
  833.     /* ARGSUSED */
  834. static Tcl_HashEntry *
  835. BogusCreate(tablePtr, key, newPtr)
  836.     Tcl_HashTable *tablePtr;    /* Table in which to lookup entry. */
  837.     char *key;            /* Key to use to find or create matching
  838.                  * entry. */
  839.     int *newPtr;        /* Store info here telling whether a new
  840.                  * entry was created. */
  841. {
  842.     panic("called Tcl_CreateHashEntry on deleted table");
  843.     return NULL;
  844. }
  845.  
  846. /*
  847.  *----------------------------------------------------------------------
  848.  *
  849.  * RebuildTable --
  850.  *
  851.  *    This procedure is invoked when the ratio of entries to hash
  852.  *    buckets becomes too large.  It creates a new table with a
  853.  *    larger bucket array and moves all of the entries into the
  854.  *    new table.
  855.  *
  856.  * Results:
  857.  *    None.
  858.  *
  859.  * Side effects:
  860.  *    Memory gets reallocated and entries get re-hashed to new
  861.  *    buckets.
  862.  *
  863.  *----------------------------------------------------------------------
  864.  */
  865.  
  866. static void
  867. RebuildTable(tablePtr)
  868.     register Tcl_HashTable *tablePtr;    /* Table to enlarge. */
  869. {
  870.     int oldSize, count, index;
  871.     Tcl_HashEntry **oldBuckets;
  872.     register Tcl_HashEntry **oldChainPtr, **newChainPtr;
  873.     register Tcl_HashEntry *hPtr;
  874.  
  875.     oldSize = tablePtr->numBuckets;
  876.     oldBuckets = tablePtr->buckets;
  877.  
  878.     /*
  879.      * Allocate and initialize the new bucket array, and set up
  880.      * hashing constants for new array size.
  881.      */
  882.  
  883.     tablePtr->numBuckets *= 4;
  884.     tablePtr->buckets = (Tcl_HashEntry **) ckalloc((unsigned)
  885.         (tablePtr->numBuckets * sizeof(Tcl_HashEntry *)));
  886.     for (count = tablePtr->numBuckets, newChainPtr = tablePtr->buckets;
  887.         count > 0; count--, newChainPtr++) {
  888.     *newChainPtr = NULL;
  889.     }
  890.     tablePtr->rebuildSize *= 4;
  891.     tablePtr->downShift -= 2;
  892.     tablePtr->mask = (tablePtr->mask << 2) + 3;
  893.  
  894.     /*
  895.      * Rehash all of the existing entries into the new bucket array.
  896.      */
  897.  
  898.     for (oldChainPtr = oldBuckets; oldSize > 0; oldSize--, oldChainPtr++) {
  899.     for (hPtr = *oldChainPtr; hPtr != NULL; hPtr = *oldChainPtr) {
  900.         *oldChainPtr = hPtr->nextPtr;
  901.         if (tablePtr->keyType == TCL_STRING_KEYS) {
  902.         index = HashString(hPtr->key.string) & tablePtr->mask;
  903.         } else if (tablePtr->keyType == TCL_ONE_WORD_KEYS) {
  904.         index = RANDOM_INDEX(tablePtr, hPtr->key.oneWordValue);
  905.         } else {
  906.         register int *iPtr;
  907.         int count;
  908.  
  909.         for (index = 0, count = tablePtr->keyType,
  910.             iPtr = hPtr->key.words; count > 0; count--, iPtr++) {
  911.             index += *iPtr;
  912.         }
  913.         index = RANDOM_INDEX(tablePtr, index);
  914.         }
  915.         hPtr->bucketPtr = &(tablePtr->buckets[index]);
  916.         hPtr->nextPtr = *hPtr->bucketPtr;
  917.         *hPtr->bucketPtr = hPtr;
  918.     }
  919.     }
  920.  
  921.     /*
  922.      * Free up the old bucket array, if it was dynamically allocated.
  923.      */
  924.  
  925.     if (oldBuckets != tablePtr->staticBuckets) {
  926.     ckfree((char *) oldBuckets);
  927.     }
  928. }
  929.